home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / NewEXT / NewExt.pas < prev    next >
Pascal/Delphi Source File  |  1995-11-13  |  6KB  |  217 lines
  1. PROGRAM NewExt;
  2.  
  3. {$F-,I-,R-,S-,V-,M 5,1,1,15}
  4.  
  5. USES DOS, AmigaDOS, Amiga, Exec, Intuition;   
  6.                 { CLI utility to change multiple files extensions }
  7.  
  8. { ================================ }
  9.  
  10. FUNCTION ParseArgs(VAR wldcrd, ext : string; VAR Front, Infos : Boolean) : BOOLEAN;
  11.  
  12. VAR
  13.     Template : String;
  14.     n        : Byte;
  15.     RDArg    : pRDArgs;
  16.     TmpInt   : ^LongInt;
  17.     V2       : Boolean;
  18.     
  19. CONST
  20.     RD_Array : Array[0..4] of LongInt = (0);
  21.     INFO = 4;
  22.  
  23. BEGIN
  24.     Template := 'WILDCARD/A,EXTENSION/A,FRONT/S,HELP/S,INFOS/S'#0;
  25.                 
  26.     If pExecBase(SysBase)^.LibNode.lib_Version >= 36 then V2 := True else V2 := False;
  27.     
  28.     If V2 then begin
  29.         { WB 2 or greater :-) }
  30.         RDArg := AllocDosObject(DOS_RDARGS,NIL);
  31.         If RDArg <> NIL then begin
  32.             RDArg := ReadArgs(@Template[1],@RD_Array,RDArg);
  33.             
  34.             if RD_Array[0] <> 0 then
  35.                 wldcrd := PtrToPas(Pointer(RD_Array[0]));
  36.                 
  37.             if RD_Array[1] <> 0 then
  38.                 ext := PtrToPas(Pointer(RD_Array[1]));
  39.                 
  40.             if RD_Array[2] <> 0 then Front := True else Front := false;
  41.             
  42.             if RD_Array[INFO] <> 0 then Infos := True else Infos := false;
  43.             
  44.             if RD_Array[3] <> 0 then begin
  45.                 Writeln('NewEXT ©Lee Kindness'#10+
  46.                      ''#10+
  47.                      'Batch changes the extensions of files.'#10+
  48.                      'eg. NewEXT #?.PIC .ILBM will change the extension of all #?.PIC to .ILBM'#10+
  49.                      '    NewEXT mod.#? pt3. FRONT will change the front ext of all mod.#? to pt3.');
  50.              Writeln('    NewEXT (#?.samp|#?.sfx) .8SVX will change all #?.samp and #?.sfx to .8SVX'#10+
  51.                      ''#10+
  52.                      template);
  53.           end;
  54.         
  55.             FreeArgs(RDArg);
  56.             FreeDosObject(DOS_RDARGS,RDArg);
  57.         
  58.         end;
  59.     end;
  60.     If (RD_Array[3] = 0) and (RD_Array[0] <> 0) and (RD_Array[1] <> 0) then 
  61.         ParseArgs := True
  62.     else
  63.         ParseArgs := False; 
  64. END;
  65.  
  66. { ================================ }
  67.  
  68. PROCEDURE DoTheNaming(wldcrd,ext : String; Front, Infos : Boolean;
  69.                             VAR counter : INTEGER);
  70.                             
  71. TYPE
  72.     pNameNode = ^tNameNode;
  73.     tNameNode = Record
  74.         nn_Node : tMinNode;
  75.         nn_Name : String[180];
  76.     end;
  77.     
  78. CONST
  79.     Header : String[13] = 'Can''t rename'#0;
  80.     
  81. VAR
  82.     NewName,DirBit,NameBit,ExtBit,outinitialname,
  83.     InfoName, NewInfoName : string;
  84.     OK, renameok, nobreak : boolean;
  85.     ap                    : pAnchorPath;
  86.     rc, Signals           : Longint;
  87.     list                  : pMinList;
  88.     node                  : pNameNode;
  89.     rk                    : pRemember;
  90.     tmp                   : String[180];
  91.     n                     : byte;
  92.     MyIO                  : Integer;
  93.  
  94. BEGIN
  95.     nobreak := true;
  96.     rk := NIL;
  97.     wldcrd := wldcrd+#0;
  98.     ap := AllocRemember(@rk, Sizeof(tAnchorPath)+255,MEMF_PUBLIC|MEMF_CLEAR);
  99.     list := AllocRemember(@rk, Sizeof(tList),MEMF_PUBLIC|MEMF_CLEAR);
  100.     if (ap <> NIL) and (list <> NIL) then begin
  101.         NewList(pList(list));
  102.         AP^.ap_BreakBits := SIGBREAKF_CTRL_C;
  103.         AP^.ap_Strlen := 255;
  104.         rc := MatchFirst(@wldcrd[1], ap);
  105.         While rc = 0 do begin
  106.             { Problem : we cant just rename files in the match loop, they may be }
  107.             { rematched by MatchNext(), creating a neverending loop! Read them   }
  108.             { into a list instead                                                }
  109.             if ap^.ap_Info.fib_DirEntryType < 0 then begin
  110.                 node := allocRemember(@rk, sizeof(tNameNode),MEMF_CLEAR|MEMF_PUBLIC);
  111.                 if node <> NIL then begin
  112.                 
  113.                     tmp := PtrToPAs(@ap^.ap_buf);
  114.                     node^.nn_Name := tmp;
  115.                 
  116.                     AddTail(pList(list),pNode(node));
  117.                 end else
  118.                     DisplayBeep(NIL);
  119.             end;
  120.                         
  121.             rc := MatchNext(Ap);
  122.         end;
  123.         {read files from list}
  124.         node := pNameNode(list^.mlh_Head);
  125.         While (node^.nn_Node.mln_Succ <> NIL) and (nobreak) do begin
  126.             renameok := false;
  127.             
  128.             outInitialName := node^.nn_Name + ' ';
  129.             
  130.             FOR n := (length(outinitialname)+1) TO 30 DO 
  131.                 outinitialname := outinitialname + '.'; { pad to make output nicer }
  132.             
  133.             if Front then begin
  134.                 { find first . }
  135.                 n := pos('.',node^.nn_Name);
  136.                 if n <> 0 then begin
  137.                     renameok := true;
  138.                     extbit := copy(node^.nn_Name,1,n);
  139.                     namebit := copy(node^.nn_Name,n+1,length(node^.nn_Name)-n);
  140.                     newname := ext+namebit+#0;
  141.                     NewInfoName := ext+namebit+'.info'+#0;
  142.                 end;
  143.             end else begin
  144.                 FSPLIT(node^.nn_Name,DirBit,NameBit,ExtBit); { split name into individual bits }
  145.                 NewName := DirBit+NameBit+ext+#0; { and glue new name together }
  146.                 NewInfoName := DirBit+NameBit+ext+'.info'+#0;
  147.                 renameok := true; 
  148.             end;
  149.             
  150.             if renameok then begin
  151.                 InfoName := node^.nn_Name+'.info'#0;
  152.                 node^.nn_Name := node^.nn_Name+#0;
  153.                 WRITE(' ',outinitialname,' ');
  154.                 OK := RENAME_(@node^.nn_Name[1], @NewName[1]);
  155.                 
  156.                 myIO := IOErr;
  157.                 if myIO = 0 then begin
  158.                       WRITELN(newname);
  159.                      counter := counter + 1; { changed the name of 1 more file }
  160.                 end else begin
  161.                     Delay(30);
  162.                     If NOT PrintFault(myIO, @Header[1]) then Writeln; 
  163.                 end;
  164.                 If Infos then
  165.                     if NOT Rename_(@InfoName[1], @NewInfoName[1]) then 
  166.                         Ok := PrintFault(IOErr, NIL);
  167.             end;
  168.  
  169.             signals := SetSignal(0,0);
  170.             { check for Ctrl-C break by user }
  171.             If (Signals and SIGBREAKF_CTRL_C) <> 0 then begin
  172.                 Writeln('***Break');
  173.                 NoBreak := False;
  174.                 Signals := SetSignal(0,SIGBREAKF_CTRL_C);
  175.             end;
  176.     
  177.             node := pNameNode(node^.nn_Node.mln_Succ);
  178.         end;
  179.         FreeRemember(@rk,true);
  180.     end;
  181. end;
  182.  
  183. { ================================ }
  184. { ================================ }         
  185.  
  186. PROCEDURE Main;
  187.  
  188. CONST 
  189.     ver    : string[28] = '$VER: NewExt 1.5 (13.11.95)'#0;
  190.                          { string to be given by version command }
  191. VAR 
  192.     wldcrd, ext  : String;
  193.     Front, infos : Boolean;
  194.     counter      : INTEGER;
  195.  
  196.  
  197. BEGIN
  198.     counter := 0;
  199.     IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',0));
  200.     if (IntuitionBase <> NIL) and (pLibrary(DOSBase)^.lib_Version >= 36) then begin
  201.         IF ParseArgs(wldcrd,ext,Front, Infos) THEN BEGIN
  202.             DoTheNaming(wldcrd,ext,front,infos,counter); { rename and find next matches }
  203.             CASE Counter OF
  204.                 0  : WRITELN('No File extensions changed.');
  205.                 1  : WRITELN('1 file extension changed.');
  206.                 ELSE WRITELN(counter,' file extensions changed.');
  207.             END; {case} { print out some crap at the end }
  208.         END ELSE begin
  209.             if NOT PrintFault(IOErr, NIL) then begin end;
  210.             HALT(10); { exit if the parameters were invalid }
  211.         end;
  212.         CloseLibrary(pLibrary(IntuitionBase));
  213.     end;
  214. END; {main}
  215. { ================================ }
  216. BEGIN main END.
  217. { ================================ }